home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / COMAL / B-Book Series / (k)b6.d64 / play.l < prev    next >
Text File  |  2007-02-28  |  2KB  |  87 lines
  1. 9000 PROC PLAY(MUSIC$,TEMPO) CLOSED
  2. 9010 SID:=54272; POINTER:=0; END'OF'NOTES:=LEN(MUSIC$)
  3. 9020 REPEAT 
  4. 9030 POINTER:+1
  5. 9040 CASE MUSIC$(POINTER) OF
  6. 9050 WHEN "C"
  7. 9060 IF MUSIC$(POINTER+1)="#" THEN
  8. 9070 FREQ:=36376; POINTER:+1
  9. 9080 ELSE 
  10. 9090 FREQ:=34334
  11. 9100 ENDIF 
  12. 9110 WHEN "D"
  13. 9120 IF MUSIC$(POINTER+1)="#" THEN
  14. 9130 FREQ:=40830; POINTER:+1
  15. 9140 ELSE 
  16. 9150 FREQ:=38539
  17. 9160 ENDIF 
  18. 9170 WHEN "E"
  19. 9180 FREQ:=43258
  20. 9190 WHEN "F"
  21. 9200 IF MUSIC$(POINTER+1)="#" THEN
  22. 9210 FREQ:=48556; POINTER:+1
  23. 9220 ELSE 
  24. 9230 FREQ:=45830
  25. 9240 ENDIF 
  26. 9250 WHEN "G"
  27. 9260 IF MUSIC$(POINTER+1)="#" THEN
  28. 9270 FREQ:=54502; POINTER:+1
  29. 9280 ELSE 
  30. 9290 FREQ:=51443
  31. 9300 ENDIF 
  32. 9310 WHEN "A"
  33. 9320 IF MUSIC$(POINTER+1)="#" THEN
  34. 9330 FREQ:=61176; POINTER:+1
  35. 9340 ELSE 
  36. 9350 FREQ:=57743
  37. 9360 ENDIF 
  38. 9370 WHEN "B"
  39. 9380 FREQ:=64814
  40. 9390 WHEN "R"
  41. 9400 FREQ:=0
  42. 9410 OTHERWISE 
  43. 9420 PRINT "'",MUSIC$(POINTER),"' IS NOT A VALID NOTE"
  44. 9430 CLOSE
  45. 9440 END 
  46. 9450 ENDCASE 
  47. 9460 POINTER:+1
  48. 9470 IF MUSIC$(POINTER)<>"-" THEN
  49. 9480 PRINT "'-' IS NEEDED TO SEPERATE NOTE AND      OCTAVE"
  50. 9490 CLOSE
  51. 9500 END 
  52. 9510 ENDIF 
  53. 9520 POINTER:+1
  54. 9530 OCTAVE:=ORD(MUSIC$(POINTER))-ORD("0")
  55. 9540 IF OCTAVE<0 OR OCTAVE>7 THEN
  56. 9550 PRINT "OCTAVE RANGE IS 0-7 ONLY"
  57. 9560 CLOSE
  58. 9570 END 
  59. 9580 ENDIF 
  60. 9590 FREQ:=FREQ DIV 2^OCTAVE
  61. 9600 POKE SID,FREQ MOD 256
  62. 9610 POKE SID+1,FREQ DIV 256
  63. 9620 TEMP:=(PEEK(1023) DIV 2)*2+1
  64. 9630 POKE SID+4,TEMP
  65. 9640 POKE 1023,TEMP
  66. 9650 POINTER:+1
  67. 9660 IF MUSIC$(POINTER)<>":" THEN
  68. 9670 PRINT "':' IS NEEDED TO SEPARATE OCAVE AND DURATION"
  69. 9680 CLOSE
  70. 9690 END 
  71. 9700 ENDIF 
  72. 9710 POINTER:+1
  73. 9720 DUR:=ORD(MUSIC$(POINTER))-ORD("0")
  74. 9730 POINTER:+1
  75. 9740 IF POINTER<=END'OF'NOTES THEN
  76. 9750 IF MUSIC$(POINTER)>="0" AND MUSIC$(POINTER)<="9" THEN
  77. 9760 DUR:=DUR*10+ORD(MUSIC$(POINTER))-ORD("0")
  78. 9770 POINTER:+1
  79. 9780 ENDIF 
  80. 9790 ENDIF 
  81. 9800 FOR T:=0 TO TEMPO DIV DUR DO NULL
  82. 9810 TEMP:=(PEEK(1023) DIV 2)*2
  83. 9820 POKE 54272+4,TEMP
  84. 9830 POKE 1023,TEMP
  85. 9840 UNTIL POINTER>END'OF'NOTES
  86. 9850 ENDPROC PLAY
  87.